home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 14 / hacker14.iso / programacao / visual / perl.exe / {app} / Templates / other / Clipper.clp < prev    next >
Encoding:
Text File  |  2003-01-11  |  2.4 KB  |  104 lines
  1. // "Snake" - A screen Saver for Clipper V5.
  2. //
  3. //      Patrick Imbault
  4. //      6 Rue de l'Ecluse
  5. //      77000 MELUN
  6. //      FRANCE
  7. //      CIS:100012,1450
  8. //
  9. //  call SNAKE() to use it, it returns always .T.
  10. //  compile CLIPPER snake /N /W
  11.  
  12. #Define SPEED      .1
  13. #Define LMAX       15
  14. #Define FRAC(x)    (x - INT(x))
  15. #Define S_SNAKE(x) (SUBSTR(CHR(176) + CHR(177) + CHR(178) + CHR(219), x, 1))
  16. #Define SIGN(x)    IIF(x > 0, 1, IIF(x < 0, -1, 0))
  17.  
  18. STATIC seed
  19.  
  20. FUNCTION SNAKE
  21.   LOCAL i, nXd := 0, nYd := 0, nLon, nDiff, nAvis, nForm, nLon2, nP, nP2
  22.   LOCAL cSc, nrow := row(), ncol := col(), anc_cu
  23.   seed := FRAC(seconds() / 1000)
  24.   nP := ARRAY(LMAX, 2)
  25.   nP[1, 1] := 40
  26.   nP[1, 2] := 12
  27.   nAvis := MAX(5, alea(LMAX))
  28.   nForm := MAX(5, alea(LMAX))
  29.   cDir(@nXd, @nYd)
  30.   nLon := MAX(4, alea(10))
  31.   nLon2 := nLon
  32.   FOR i := 2 TO nLon
  33.     nP[i, 1] := nP[1, 1]
  34.     nP[i, 2] := nP[1, 2] - (i - 1)
  35.   NEXT i
  36.   cSc := savescreen(0, 0, maxrow(), maxcol())
  37.   CLEAR SCREEN
  38.   anc_cu := setcursor(0)
  39.   sdisp(nP, nLon)
  40.   DO WHILE inkey(SPEED) == 0
  41.     if nAvis-- < 0
  42.       nAvis := MAX(5, alea(LMAX))
  43.       cdir(@nXd, @nYd)
  44.     endif
  45.     if nForm-- < 0
  46.       nForm := MAX(5, alea(LMAX))
  47.       nLon2 := MAX(4, alea(10))
  48.     ENDIF
  49.     sundisp(nP, nLon)
  50.     nDiff := nLon2 - nLon
  51.     cPos(@nP, @nXd, @nYd, nLon, nDiff > 0)
  52.     nLon += SIGN(nDiff)
  53.     sdisp(nP, nLon)
  54.   ENDDO
  55.   restscreen(0, 0, maxrow(), maxcol(), cSc)
  56.   setcursor(anc_cu)
  57.   setpos(nrow, ncol)
  58. RETURN .T.
  59.  
  60. FUNCTION sundisp(nP, nLon)
  61.   LOCAL j
  62.   FOR j := 1 TO nLon
  63.     @ nP[j, 2], nP[j, 1] say "  "
  64.   NEXT j
  65. RETURN NIL
  66.  
  67. FUNCTION sdisp(nP, nLon)
  68.   LOCAL i := 1, j
  69.   FOR j := nLon TO 1 STEP -1
  70.     @ nP[j, 2], nP[j, 1] say REPLICATE(S_SNAKE(INT(i)), 2)
  71.     i += (4 / nLon)
  72.   NEXT j
  73. RETURN NIL
  74.  
  75. FUNCTION cpos(nPa, nXd, nYd, nLon, inc)
  76.   LOCAL i, x, y
  77.   x := nPa[1, 1] + nXd
  78.   y := nPa[1, 2] + nYd
  79.   DO WHILE x < 0 .OR. x > MAXCOL() .OR. y < 0 .OR. y > MAXROW()
  80.     cdir(@nXd, @nYd)
  81.     x := nPa[1, 1] + nXd
  82.     y := nPa[1, 2] + nYd
  83.   ENDDO
  84.   FOR i := nLon + IIF(inc <> NIL .AND. inc, 1, 0) TO 2 STEP -1
  85.     nPa[i, 1] := nPa[i - 1, 1]
  86.     nPa[i, 2] := nPa[i - 1, 2]
  87.   NEXT i
  88.   nPa[1, 1] := x
  89.   nPa[1, 2] := y
  90. RETURN NIL
  91.  
  92. FUNCTION cdir(x, y)
  93.   x := alea(3) - 1
  94.   y := alea(3) - 1
  95.   DO WHILE x = 0 .AND. y = 0
  96.     x := alea(3) - 1
  97.     y := alea(3) - 1
  98.   ENDDO
  99. RETURN NIL
  100.  
  101. FUNCTION alea(nX)
  102.   seed := FRAC(seed * 9821 + .211327)
  103. RETURN INT(seed * nX)
  104.